(in-package :ws-sql)

(declaim (optimize (debug 3) (safety 2)))

(defvar *connection* nil 
  "The singleton instance of the JDBC Connection class which will be
  used for communication with the database.")
(defvar *jdbc-config* nil
  "The JDBC parameters used to build the *connection* object.")
(defvar *metadata* nil
  "The singleton reference to database metadata obtained from the
  *connection*.")

(defvar *jdbc-initialization-hooks*
  `(("postgresql" . #'postgres-hook)
    ("ojdbc14_g" . #'oracle-hook)
    ("jtds-1.2.2" . #'sybase-hook)))

(defun database-initialize (&optional (id "at.etel.jdbc.infodb.test"))
  "Return an instance of java.sql.Connection to the database specified
  by the optional ID string.

As a side-effect, the *METADATA* variable will contain a reference to
the associated java.sql.DatabaseMetadata.

The mapping of IDs to database connection parameters is contained
  within the *JDBC-CONFIG* parameter." 
  (unless *jdbc-config*
    (load-jdbc-configs))
  (setf *connection* (jdbc-init id))
  (possibly-refresh-metadata)
  *connection*)

(defun load-jdbc-configs (&optional (file
				     ws-sql-system::*config-iri*))
  (verbose "Loading JDBC configuration from '~A'" file)
  (setf *jdbc-config* (database-configs-from-file 
			 (resolve-as-pathname 
			  ws-sql-system::*config-iri*))))


(defun jdbc-init (id)
  "Return a Java Connection object for the given ID."
  (let ((parameters (gethash id *jdbc-config*)))
    (unless parameters
      (warn "No id for '~A' found in ~A." id *jdbc-config*)
      (return-from jdbc-init nil))
    (let ((jar (cdr (assoc "jars" parameters :test #'equal))))
      (unless jar 
	(error "No 'jars' key found in ~A." parameters))
      (funcall (eval 
		(cdr (assoc jar
			    *jdbc-initialization-hooks*
			    :test #'equal)))
	       parameters))))


(defpackage :jdbc (:nicknames "jdbc")
	    (:export "root" 
		     "config" "driver-jars"
		     "uri" "password" "username"))
(s-xml:register-namespace "urn:at.etel.ws.sql.jdbc.config" "jdbc" :jdbc)

(defun database-configs-from-file (filename) 
  (let ((xml (s-xml:parse-xml-file filename))
	(result (make-hash-table :test #'equal)))
    (loop :for config :in xml 
       :do (when (and (not (eql (first config)
				'jdbc:|root|))
		      (eql (first (first config)) 'jdbc:|config|))
	     (let* ((attributes (rest (first config)))
		    (id (getf attributes ':|id|))
		    (driver-jars (getf attributes
				       'jdbc:|driver-jars|)))
#|
	       (verbose "attributes=~A id=~A driver-jars=~A (rest config)=~A"
			attributes id driver-jars (rest config))
|#
	       (when id
		 (setf (gethash id result)
		       (append 
			(loop :for key-value :in (rest config)
			   :do (verbose "key-value=~A" key-value)
			   :collecting (cons (symbol-name (first key-value))
					     (second key-value)))
			(list (cons "jars" driver-jars))))))))
    result))
		    

(defun resolve-as-pathname (iri)
  "Resolve an IRI as a returning a valid PATHNAME.~ 

Currently accepts only a local pathname iri (i.e. a string starting with
'file://')."
  (let ((file-prefix "file://"))
    (when (= (search file-prefix iri) 0)
      (pathname (subseq iri (length file-prefix))))))



(defun get-alist-value (alist key &optional default)
  (or (cdr (assoc key alist :test #'equal))
       default))

#|
;XXX why doesn't this work?  Too hungover to figure this out
(defmacro get-alist-value (alist key &optional default)
  `(or (cdr (assoc ,key ,alist :test ,#'equal))
       ,default))
|#


;;;; Every "database-HOOK" returns a JDBC Connection object.
(defun postgres-hook (parameters)
  (let ((jdbc-uri (get-alist-value parameters "uri" 
				   "jdbc:postgresql://localhost/evenson"))
	(username (get-alist-value parameters "username" "evenson"))
	(server-name (get-alist-value parameters "server-name"
				      "localhost")))
    (declare (ignorable jdbc-uri))
    (let ((ds (new 'PGSimpleDataSource)))
      (#"setServerName" ds server-name)
      (#"setDatabaseName" ds "evenson")
      (#"setUser" ds username)
      (#"getConnection" ds))))

(defun alist-parse (parameters)
  "Return list for ('uri' 'username' 'password') alist keys in PARAMETERS"
  (mapcar (lambda (key) (get-alist-value parameters key))
		  '("uri" "username" "password")))
   
(defun oracle-hook (parameters)
  (destructuring-bind (uri username password)
      (alist-parse parameters)
    (if (and uri username password)
	(let ((oracle-data-source 
	       (new 'oracle.jdbc.pool.OracleDataSource)))
	  (#"setURL" oracle-data-source uri)
	  (#"getConnection" oracle-data-source username password))
	(error "Not enough information provided to initialize
  connection."))))

(defun sybase-hook (parameters)
  (destructuring-bind (uri username password)
      (alist-parse parameters)
    (if (and uri username password)
	(let ((sybase-data-source 
	       (#"forName" 'java.lang.Class "net.sourceforge.jtds.jdbc.Driver")
	       (new 'net.sourceforge.jtds.jdbcx.JtdsDataSource)))
	  (#"setURL" sybase-data-source uri)
	  (#"getConnection" sybase-data-source username password))
	(warn "Not enough information provider to initialize
  connection."))))
	
(define-condition sql-exception (java-exception) ())
(register-java-exception "java.sql.SQLException" 'sql-exception)

(defun possibly-refresh-metadata ()
  (unless *connection*
    (error "No *metadata* to work with.  Run DATABASE-INITIALIZE."))
  (handler-case 
      (setf *metadata* (#"getMetaData" *connection*))
    (java-exception (e) 
      (progn
	(warn "Unable to get metadata because of '~A', attempting to refresh the
database connection." e)
	(database-initialize))))) ; XXX initializes the default 
      
(defun database-alist-from-file (filename)
  ;;; XXX deal with namespaces more dynamically
  (let ((xml (s-xml:parse-xml-file filename))
	(result '()))
    (push (cons 'uri (second (lxml-find-tag 
			      '|jdbc|:|uri| xml))) result)
    (push (cons 'password (second (lxml-find-tag 
				   '|jdbc|:|password| xml))) result)
    (push (cons 'username (second (lxml-find-tag
				   '|jdbc|:|username| xml))) result)
    result))
